home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / FONT_UTL / GRFTXT / GTXTNOMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-19  |  8KB  |  233 lines
  1. {$I+}    {I/O checking on}
  2. program Gtxtnomo;      {Fast display of Text in Graphics mode.}
  3.                        {works on horizontal 8 pixel boundaries }
  4.                        {For EGA/VGA only - Bugs/problems/sugesstions welcomed!}
  5.                        {Author: Tim Godfrey, 72617,2125 }
  6.                        {Previous version loaded Fonts as .OBJ files into TPU }
  7.                        { Version 27 Jan 89 }
  8.                        {Fixed bug in ASMs causing eventual stack overflow}
  9.                        {Added SetYOfset to allow "Pseudo Paging" for EGA modes}
  10.                        {to write on second page, just add 350 to Y coordinates}
  11.                        { Version 1 Feb 89 }
  12.                        {Added true paging support of SetActivePage and }
  13.                        { SetVisualPage from the Graph Unit}
  14.  
  15.                        { Version 7 Jul 89 }
  16.                        { Added new Procedure SetGfont, eliminating requirement
  17.                        { of passing the font data with every procedure call}
  18.                        { Improved optimization of assembler }
  19.                        { Added Pitch variable to support pixels per line other }
  20.                        { than 640. Pitch is number of _bytes_ per scan line}
  21.  
  22.  
  23. Uses
  24.   opCrt,dos,Graph,graftext;
  25.  
  26. type
  27.    hstype        =   string[2];
  28.    filenametype  =   string[24];
  29.  
  30. var
  31.    err,fchar,xline,idx      :   integer;
  32.    teststr                  :   string;
  33.    resxstr,resystr          :   string[10];
  34.    rowaray                  :   array [0..255] of byte;
  35.    dot,fpix,lentxtpix       :   integer;
  36.    maxtextlines             :   integer;
  37.    akey                     :   char;
  38.    numstr                   :   string[10];
  39.    z,yofs,startaddr           :   word;
  40.    inx                        :   integer;
  41.    s_hr,s_min,s_sec,s_hs,e_hr,e_min,e_sec,e_hs : word;
  42.    s_hsecs,e_hsecs,iterations                  : longint;
  43.    reprate,deltasecs                           : real;
  44.  
  45. {----------------Graphics Support Section--------------------}
  46.  
  47.  
  48. const
  49.   { The names of the various device drivers supported }
  50.   DriverNames : array[0..10] of string[8] =
  51.   ('Detect', 'CGA', 'MCGA', 'EGA', 'EGA64', 'EGAMono',
  52.    'RESERVED', 'HercMono', 'ATT400', 'VGA', 'PC3270');
  53.  
  54.   { The five fonts available }
  55.   Fonts : array[0..4] of string[13] =
  56.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  57.  
  58.   { The five predefined line styles supported }
  59.   LineStyles : array[0..4] of string[9] =
  60.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  61.  
  62.   { The twelve predefined fill styles supported }
  63.   FillStyles : array[0..11] of string[14] =
  64.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  65.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  66.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  67.  
  68.   { The two text directions available }
  69.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  70.  
  71.   { The Horizontal text justifications available }
  72.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  73.  
  74.   { The vertical text justifications available }
  75.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  76.  
  77. var
  78.   GraphDriver : integer;  { The Graphics device driver }
  79.   GraphMode   : integer;  { The Graphics mode value }
  80.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  81.   ErrorCode   : integer;  { Reports any graphics errors }
  82.   MaxColor    : word;     { The maximum color value available }
  83.   OldExitProc : Pointer;  { Saves exit procedure address }
  84.   textx,texty : word;
  85.  
  86. Function BGIpath(bginame:string) : string;
  87. var
  88.      fullname : string;
  89.      fpath,path1    : dirstr;
  90.      Name     : NameStr;
  91.      Ext      : ExtStr;
  92.      p1len    : integer;
  93.      path2    : string;
  94.      found    : boolean;
  95.  
  96. begin
  97.    fsplit(paramstr(0),path1,name,ext);
  98.    p1len := length(path1);
  99.    if not (path1[pred(p1len)]=':') then delete(path1,p1len,1);
  100.  
  101.    if length(path1)=0 then  {program directory is same as current directory}
  102.       path2 := '.;'+getenv('PATH')
  103.    else
  104.       path2 := path1+';'+getenv('PATH');    {put program's directory in search path}
  105.  
  106.    fpath := fsearch(BGIname,path2);
  107.    if fpath = '' then begin
  108.       Write(bginame,' Not Found on path or program directory. Press any key.');
  109.       repeat until keypressed;
  110.       BGIpath := '';
  111.       end
  112.    else begin
  113.       fsplit(fexpand(fpath),path1,name,ext);
  114.       p1len := length(path1);
  115.       if not (path1[pred(p1len)]=':') then delete(path1,p1len,1);
  116.       BGIpath := path1;
  117.       end;
  118. end;
  119.  
  120.  
  121.  
  122. {$F+}
  123. procedure MyExitProc;
  124. begin
  125.   ExitProc := OldExitProc; { Restore exit procedure address }
  126.   CloseGraph;              { Shut down the graphics system }
  127. end; { MyExitProc }
  128. {$F-}
  129.  
  130. procedure Initialize;
  131. { Initialize graphics and report any errors that may occur }
  132. begin
  133.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  134.   DirectVideo := False;
  135.   OldExitProc := ExitProc;                { save previous exit proc }
  136.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  137. if (paramcount>0) and ((paramstr(1)='/V') or (paramstr(1)='/v')) then begin
  138.   GraphDriver := VGA;
  139.   graphmode := VGAHi;
  140.   end
  141. else if (paramcount>0) and ((paramstr(1)='/E') or (paramstr(1)='/e')) then begin
  142.  
  143.   GraphDriver := EGA;
  144.   graphmode := EGAHi;
  145.   end
  146.  
  147.   else
  148.   graphdriver := detect;
  149.  
  150.   InitGraph(GraphDriver, graphmode,BGIpath('EGAVGA.BGI'));  { activate graphics }
  151.   ErrorCode := GraphResult;               { error? }
  152.   if ErrorCode <> grOk then
  153.   begin
  154.     Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  155.     writeln('(A /V parameter will force VGA mode.)');
  156.     Halt(1);
  157.   end;
  158.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  159.   MaxX := GetMaxX;          { Get screen resolution values }
  160.   MaxY := GetMaxY;
  161. end; { Initialize }
  162.  
  163.  
  164. {_______________________________________________________}
  165.  
  166. {-----------------Mainline Program-----------------------}
  167.  
  168.  
  169. begin
  170.  
  171. teststr := 'This is a test 01234567890 (8x8 font) ';
  172.  
  173. Initialize;  {graphics activation}
  174.  
  175. maxtextlines := (Maxy div 8) -1;
  176. str(1+maxx,resxstr);
  177. str(1+maxy,resystr);
  178. teststr := resxstr+'x'+resystr+' test 01234567890 (8x8 font) ';
  179.  
  180.  
  181. setfillStyle(widedotfill,lightgray);
  182.  
  183.  
  184. Bar(0,0,Maxx,Maxy);
  185.  
  186. SetGfont(Thin8);
  187. inx := 0;
  188.  
  189.  
  190. iterations := 0;
  191. gettime(s_hr,s_min,s_sec,s_hs);
  192. repeat
  193. (*
  194.   Gtxtsol(100,100+(inx*14),blue,inx,teststr);
  195. *)
  196.   for idx := 0 to 15 do
  197.      Gtxtsol(8,(9*idx),blue,(idx+inx) and $F,teststr);
  198.   for idx := 0 to 15 do
  199.      Gtxtsol(8,(MaxY div 2)+(9*idx),red,(idx+inx) and $F ,teststr);
  200.   for idx := 0 to 15 do
  201.      Gtxtsol(10+(MaxX div 2),(9*idx),green,(idx+inx) and $F,teststr);
  202.   for idx := 0 to 15 do
  203.      Gtxtsol(10+(MaxX div 2),(MaxY div 2)+(9*idx),darkgray,(idx+inx) and $F,teststr);
  204.  
  205. (*
  206.   line(0,0,inx*16,maxy);
  207.   setcolor(inx);
  208. *)
  209. inx := (inx + 1) and $F;
  210. inc(iterations);
  211.  
  212. until Keypressed;
  213.  
  214. gettime(e_hr,e_min,e_sec,e_hs);
  215.  
  216.  
  217.  
  218. if (keypressed) then readkey;
  219. (* Akey := readkey; *)
  220.  
  221. CloseGraph;
  222.  
  223. s_hsecs := s_hs + 100 * (s_sec + (60 * (s_min + (60 * s_hr))));
  224. e_hsecs := e_hs + 100 * (e_sec + (60 * (e_min + (60 * e_hr))));
  225.  
  226. deltasecs := (e_hsecs - s_hsecs) / 100.0 ;
  227. reprate := iterations / deltasecs;
  228.  
  229. writeln(iterations,' iterations in ',deltasecs:7:2,' seconds = ',reprate:5:2,' per second.');
  230. Writeln(Memavail div 1024,'K bytes available');
  231.  
  232. end.
  233.